home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / sortdemo.zip / SDMISC.INC < prev    next >
Text File  |  1992-04-15  |  3KB  |  97 lines
  1. (*
  2. ╔═══════════════════════════════════════════════════════════════════════════╗
  3. ║ Turbo Pascal 6.0 Include File : SDMISC.INC                                ║
  4. ╟───────────────────────────────────────────────────────────────────────────╢
  5. ║ Program : SORTDEMO.PAS                                                    ║
  6. ╟───────────────────────────────────────────────────────────────────────────╢
  7. ║ Version : 1.0                                                             ║
  8. ╟───────────────────────────────────────────────────────────────────────────╢
  9. ║ Copyright (c) 1992  by  Jon S. Russell                                    ║
  10. ╟───────────────────────────────────────────────────────────────────────────╢
  11. ║ Misc routines for SORTDEMO.PAS                                            ║
  12. ╚═══════════════════════════════════════════════════════════════════════════╝
  13.                                                                            *)
  14. {$F+  force far calls on  }
  15. procedure SortDemoExitProc;
  16. begin  (* SortDemoExitProc *)
  17.   ExitProc := OldExitProc;
  18.   CloseGraph;
  19.   writeln('Thanks for using SORTDEMO');
  20.   writeln('by Jon S. Russell');
  21. end;   (* SortDemoExitProc *)
  22. {$F-  force far calls off }
  23.  
  24. (*─────────────────────────────────────────────────────────────────────────*)
  25.  
  26. procedure InitExitProc (var OldExitProc : pointer);
  27. begin  (* InitExitProc *)
  28.   (* initialize OldExitProc variable declared in SORTDEMO.PAS such that   *)
  29.   (* anytime the program is terminated, SortDemoExitProc will be executed *)
  30.  
  31.   OldExitProc := ExitProc;        (* save original exit proc *)
  32.   ExitProc := @SortDemoExitProc;  (* insert SortDemoExitProc into chain *)
  33. end;   (* InitExitProc *)
  34.  
  35. (*─────────────────────────────────────────────────────────────────────────*)
  36.  
  37. procedure InitList (var Info : InfoType);
  38. var
  39.   i : word;
  40.  
  41. begin  (* InitList *)
  42.   Info.xElems    := 20;
  43.   Info.yElems    := 1;
  44.   Info.Len       := Info.xElems*Info.yElems;
  45.   Info.Method    := Bubble;
  46.   Info.Operation := Mix;
  47.   Info.Save      := false;
  48.   Info.Sorted    := false;
  49.  
  50.   for i := 1 to MaxNumElements do
  51.     Info.List[i].Key := i;
  52.   LoadArray(Info);
  53. end;   (* InitList *)
  54.  
  55. (*─────────────────────────────────────────────────────────────────────────*)
  56.  
  57. procedure Swap (var Info   : InfoType;
  58.                     i1, i2 : word);
  59. var
  60.   Temp : ListElemType;
  61.  
  62. begin  (* Swap *)
  63.   Temp := Info.List[i1];
  64.   Info.List[i1] := Info.List[i2];
  65.   Info.List[i2] := Temp;
  66.   ShowBlock(Info, i1);
  67.   ShowBlock(Info, i2);
  68. end;   (* Swap *)
  69.  
  70. (*─────────────────────────────────────────────────────────────────────────*)
  71.  
  72. procedure MixArray (var Info : InfoType);
  73. var
  74.   i1,i2 : word;
  75.  
  76. begin  (* MixArray *)
  77.   Info.Sorted := false;
  78.   ShowArray(Info);
  79.   FlushKeyBuffer;
  80.   repeat
  81.     i1 := Random(Info.Len) + 1;
  82.     i2 := Random(Info.Len) + 1;
  83.     Swap(Info, i1, i2);
  84.   until KeyPressed;
  85. end;   (* MixArray *)
  86.  
  87. (*─────────────────────────────────────────────────────────────────────────*)
  88.  
  89. procedure Beep;
  90. begin  (* Beep *)
  91.   sound(220);  (* 220 Hertz *)
  92.   delay(100);  (* 100 ms    *)
  93.   nosound;
  94. end;   (* Beep *)
  95.  
  96. (*─────────────────────────────────────────────────────────────────────────*)
  97.